Windows Game Programming for Dummies (2nd Edition)/WinGamProgFD.iso/mac/DirectX SDK/DXSDK/samples/Multimedia/VBSamples/DirectPlay/SimpleClient/frmClient.frm

Text File | 2001-10-08 | 9KB | 239 lines

VERSION 5.00
Begin VB.Form frmClient
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "vbSimple Client"
   ClientHeight    =   4470
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   5400
   Icon            =   "frmClient.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4470
   ScaleWidth      =   5400
   StartUpPosition =   3  'Windows Default
   Begin VB.Frame Rules
      Caption         =   "Rules"
      Height          =   855
      Left            =   60
      TabIndex        =   6
      Top             =   120
      Width           =   5295
      Begin VB.Label Label1
         BackStyle       =   0  'Transparent
         Caption         =   $"frmClient.frx":0442
         Height          =   615
         Index           =   1
         Left            =   60
         TabIndex        =   7
         Top             =   180
         Width           =   5055
      End
   End
   Begin VB.CommandButton cmdExit
      Cancel          =   -1  'True
      Caption         =   "Exit"
      Height          =   375
      Left            =   3143
      TabIndex        =   5
      Top             =   4020
      Width           =   1215
   End
   Begin VB.CommandButton cmdFace
      Caption         =   "Make Faces"
      Default         =   -1  'True
      Height          =   375
      Left            =   1043
      TabIndex        =   4
      Top             =   4020
      Width           =   1215
   End
   Begin VB.TextBox txtUserInfo
      BackColor       =   &H8000000F&
      Height          =   1935
      Left            =   60
      Locked          =   -1  'True
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   1
      Top             =   1980
      Width           =   5295
   End
   Begin VB.Frame Frame1
      Caption         =   "User Stats"
      Height          =   915
      Left            =   60
      TabIndex        =   0
      Top             =   1020
      Width           =   5235
      Begin VB.Label lblSession
         BackStyle       =   0  'Transparent
         Height          =   255
         Left            =   120
         TabIndex        =   3
         Top             =   240
         Width           =   4935
      End
      Begin VB.Label lblStats
         BackStyle       =   0  'Transparent
         Height          =   255
         Left            =   120
         TabIndex        =   2
         Top             =   540
         Width           =   4995
      End
   End
End
Attribute VB_Name = "frmClient"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
'  Copyright (C) 1999-2001 Microsoft Corporation.  All Rights Reserved.
'
'  File:       frmClient.frm
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Implements DirectPlay8Event
Private Enum MsgTypes
    Msg_NoOtherPlayers
    Msg_NumPlayers
    Msg_SendWave
End Enum

Private Sub cmdExit_Click()
    Unload Me
End Sub

Private Sub cmdFace_Click()
    'Now we just need to 'make faces'
    Dim oMsg() As Byte, lOffset As Long
    lOffset = NewBuffer(oMsg)
    AddDataToBuffer oMsg, CByte(1), SIZE_BYTE, lOffset
    dpc.Send oMsg, 0, DPNSEND_NOLOOPBACK
End Sub

Private Sub Form_Load()

    Set DPlayEventsForm = New DPlayConnect
    'First lets get the dplay connection started
    If Not DPlayEventsForm.StartClientConnectWizard(dx, dpc, AppGuid, 10, Me) Then
        Cleanup
        End
    End If

End Sub

Private Sub Form_Unload(Cancel As Integer)
    Me.Hide
    DPlayEventsForm.DoSleep 50
    Cleanup
End Sub

Private Sub DirectPlay8Event_AddRemovePlayerGroup(ByVal lMsgID As Long, ByVal lPlayerID As Long, ByVal lGroupID As Long, fRejectMsg As Boolean)
    'VB requires that we must implement *every* member of this interface
End Sub

Private Sub DirectPlay8Event_AppDesc(fRejectMsg As Boolean)
    'VB requires that we must implement *every* member of this interface
End Sub

Private Sub DirectPlay8Event_AsyncOpComplete(dpnotify As DxVBLibA.DPNMSG_ASYNC_OP_COMPLETE, fRejectMsg As Boolean)
    'VB requires that we must implement *every* member of this interface
End Sub

Private Sub DirectPlay8Event_ConnectComplete(dpnotify As DxVBLibA.DPNMSG_CONNECT_COMPLETE, fRejectMsg As Boolean)
    Dim AppDesc As DPN_APPLICATION_DESC

    If dpnotify.hResultCode <> 0 Then
        'For some reason we could not connect.  All available slots must be closed.
        MsgBox "Connect Failed.  Error: 0x" & CStr(Hex$(dpnotify.hResultCode)) & "  - This sample will now close.", vbOKOnly Or vbCritical, "Closing"
        DPlayEventsForm.CloseForm Me
    Else
        AppDesc = dpc.GetApplicationDesc(0)
        Me.Caption = AppDesc.SessionName
        lblSession = "Session Name: " & AppDesc.SessionName
        lblStats.Caption = "Total clients: " & CStr(AppDesc.lCurrentPlayers) & "/" & CStr(AppDesc.lMaxPlayers)
    End If
End Sub

Private Sub DirectPlay8Event_CreateGroup(ByVal lGroupID As Long, ByVal lOwnerID As Long, fRejectMsg As Boolean)
    'VB requires that we must implement *every* member of this interface
End Sub

Private Sub DirectPlay8Event_CreatePlayer(ByVal lPlayerID As Long, fRejectMsg As Boolean)
    'VB requires that we must implement *every* member of this interface
End Sub

Private Sub DirectPlay8Event_DestroyGroup(ByVal lGroupID As Long, ByVal lReason As Long, fRejectMsg As Boolean)
    'VB requires that we must implement *every* member of this interface
End Sub

Private Sub DirectPlay8Event_DestroyPlayer(ByVal lPlayerID As Long, ByVal lReason As Long, fRejectMsg As Boolean)
    'VB requires that we must implement *every* member of this interface
End Sub

Private Sub DirectPlay8Event_EnumHostsQuery(dpnotify As DxVBLibA.DPNMSG_ENUM_HOSTS_QUERY, fRejectMsg As Boolean)
    'VB requires that we must implement *every* member of this interface
End Sub

Private Sub DirectPlay8Event_EnumHostsResponse(dpnotify As DxVBLibA.DPNMSG_ENUM_HOSTS_RESPONSE, fRejectMsg As Boolean)
    'VB requires that we must implement *every* member of this interface
End Sub

Private Sub DirectPlay8Event_HostMigrate(ByVal lNewHostID As Long, fRejectMsg As Boolean)
    'VB requires that we must implement *every* member of this interface
End Sub

Private Sub DirectPlay8Event_IndicateConnect(dpnotify As DxVBLibA.DPNMSG_INDICATE_CONNECT, fRejectMsg As Boolean)
    'VB requires that we must implement *every* member of this interface
End Sub

Private Sub DirectPlay8Event_IndicatedConnectAborted(fRejectMsg As Boolean)
    'VB requires that we must implement *every* member of this interface
End Sub

Private Sub DirectPlay8Event_InfoNotify(ByVal lMsgID As Long, ByVal lNotifyID As Long, fRejectMsg As Boolean)
    'VB requires that we must implement *every* member of this interface
End Sub

Private Sub DirectPlay8Event_Receive(dpnotify As DxVBLibA.DPNMSG_RECEIVE, fRejectMsg As Boolean)
    'The server is telling us something.  What?
    Dim sPlayer As String, lOffset As Long
    Dim lMsg As Long, lNum As Long, lMax As Long

    GetDataFromBuffer dpnotify.ReceivedData, lMsg, LenB(lMsg), lOffset
    Select Case lMsg
    Case Msg_NumPlayers
        GetDataFromBuffer dpnotify.ReceivedData, lNum, LenB(lNum), lOffset
        GetDataFromBuffer dpnotify.ReceivedData, lMax, LenB(lMax), lOffset
        lblStats.Caption = "Total clients: " & CStr(lNum) & "/" & CStr(lMax)
    Case Msg_NoOtherPlayers
        txtUserInfo.Text = txtUserInfo.Text & "There are no other players to make funny faces at!" & vbCrLf
        txtUserInfo.SelStart = Len(txtUserInfo.Text)
    Case Msg_SendWave
        'The only data we will receive is player info
        sPlayer = GetStringFromBuffer(dpnotify.ReceivedData, lOffset)
        'Append the data to the end of the line, and autoscroll there
        txtUserInfo.Text = txtUserInfo.Text & sPlayer & " is making faces at you!" & vbCrLf
        txtUserInfo.SelStart = Len(txtUserInfo.Text)
    End Select
End Sub

Private Sub DirectPlay8Event_SendComplete(dpnotify As DxVBLibA.DPNMSG_SEND_COMPLETE, fRejectMsg As Boolean)
    'VB requires that we must implement *every* member of this interface
End Sub

Private Sub DirectPlay8Event_TerminateSession(dpnotify As DxVBLibA.DPNMSG_TERMINATE_SESSION, fRejectMsg As Boolean)
    If dpnotify.hResultCode = DPNERR_HOSTTERMINATEDSESSION Then
        MsgBox "The host has terminated this session.  This sample will now exit.", vbOKOnly Or vbInformation, "Exiting"
    Else
        MsgBox "This session has been lost.  This sample will now exit.", vbOKOnly Or vbInformation, "Exiting"
    End If
    DPlayEventsForm.CloseForm Me
End Sub